home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / FORTRAN1.LZH / GETPRV.FOR < prev    next >
Text File  |  1988-02-08  |  4KB  |  141 lines
  1.       SUBROUTINE GETPRV ( N, PRIV )
  2. C*
  3. C*                  *******************************
  4. C*                  *******************************
  5. C*                  **                           **
  6. C*                  **          GETPRV           **
  7. C*                  **                           **
  8. C*                  *******************************
  9. C*                  *******************************
  10. C*
  11. C*     SUBPROGRAM :
  12. C*          GET PRIVILEGES
  13. C*
  14. C*     AUTHOR :
  15. C*          ART RAGOSTA
  16. C*          MS 207-5
  17. C*          AMES RESEARCH CENTER
  18. C*          MOFFETT FIELD, CA  94035
  19. C*          (415) 694-5578
  20. C*
  21. C*     PURPOSE :
  22. C*          TO CHECK THE PRIVILEGES ALLOWED BY THE SYSUAF FILE AND
  23. C*          RETURN THEM IN ASCII FORM.
  24. C*
  25. C*     INPUT ARGUMENTS :
  26. C*          NONE
  27. C*
  28. C*     OUTPUT ARGUMENTS :
  29. C*          N     - THE NUMBER OF PRIVILEGES FOUND
  30. C*          PRIV  - THE ARRAY CONTAINING THE NAMES OF THE PRIVILEGES
  31. C*
  32. C*     INTERNAL WORK AREAS :
  33. C*          MASK1, MASK2 - THE MASK BITS FOR THE PRIVILEGES
  34. C*          ALL1, ALL2 - THE ASCII NAMES CORRESPONDING TO MASK1 AND MASK2
  35. C*
  36. C*     COMMON BLOCKS :
  37. C*          NONE
  38. C*
  39. C*     FILE REFERENCES :
  40. C*          NONE
  41. C*
  42. C*     SUBPROGRAM REFERENCES :
  43. C*          JPI$_AUTHPRIV,  JPI$_CURPRIV, SYS$GETJPIW
  44. C*
  45. C*     ERROR PROCESSING :
  46. C*          NONE
  47. C*
  48. C*     TRANSPORTABILITY LIMITATIONS :
  49. C*          ABSOLUTELY NOT TRANSPORTABLE
  50. C*
  51. C*     ASSUMPTIONS AND RESTRICTIONS :
  52. C*          NONE
  53. C*
  54. C*     LANGUAGE AND COMPILER :
  55. C*          ANSI FORTRAN 77
  56. C*
  57. C*     VERSION AND DATE :
  58. C*          VERSION I.0     12-APR-85
  59. C*
  60. C*     CHANGE HISTORY :
  61. C*          12-APR-85    INITIAL VERSION
  62. C*
  63. C***********************************************************************
  64. C*
  65.       CHARACTER *(*) PRIV(1)
  66.       CHARACTER *10 ALL1(32), ALL2(7)
  67.       INTEGER *2 ITEM(2)
  68.       INTEGER *4 MASK1(32), MASK2(7), ITMLST(3), QUAD(2)
  69.       EQUIVALENCE (ITEM(1),ITMLST(1))
  70. C
  71. C --- ITEM CODES
  72. C
  73.       EXTERNAL JPI$_AUTHPRIV,   JPI$_CURPRIV
  74. C
  75. C --- PRIVILEGE NAMES IN THE FIRST QUADWORD
  76. C
  77.       DATA ALL1 /     'ACNT      ', 'ALLSPOOL  ', 'BUGCHK    ',
  78.      $  'BYPASS    ', 'CMEXEC    ', 'CMKRNL    ', 'DETACH    ',
  79.      $  'DIAGNOSE  ', 'EXQUOTA   ', 'GROUP     ', 'GRPNAM    ',
  80.      $  'LOG_IO    ', 'MOUNT     ', 'NETMBX    ', 'OPER      ',
  81.      $  'PFNMAP    ', 'PHY_IO    ', 'PRMCEB    ', 'PRMGBL    ',
  82.      $  'PRMMBX    ', 'PSWAPM    ', 'SETPRI    ', 'SETPRV    ',
  83.      $  'SHARE     ', 'SHMEM     ', 'SYSGBL    ', 'SYSLCK    ',
  84.      $  'SYSNAM    ', 'SYSPRV    ', 'TMPMBX    ', 'VOLPRO    ',
  85.      $  'WORLD     '/
  86. C
  87. C --- PRIVILEGE NAMES IN THE SECOND QUAD WORD
  88. C
  89.       DATA ALL2 /     'DOWNGRADE ', 'GRPPRV    ', 'PRMJNL    ',
  90.      $  'READALL   ', 'SECURITY  ', 'TMPJNL    ', 'UPGRADE   '/
  91. C
  92. C --- MASK BITS FOR THE FIRST QUAD WORD
  93. C
  94.       DATA MASK1 /     512,          16,           8388608,
  95.      $   536870912,    2,            1,            32,
  96.      $   64,           524288,       256,          8,
  97.      $   128,          131072,       1048576,      262144,
  98.      $   67108864,     4194304,      1024,         16777216,
  99.      $   2048,         4096,         8192,         16384,
  100.      $   -2147483648,  134217728,    33554432,     1073741824,
  101.      $   4,            268435456,    32768,        2097152,
  102.      $   65536 /
  103. C
  104. C --- MASK BITS FOR THE SECOND QUAD WORD
  105. C
  106.       DATA MASK2 /     2,            4,            32,
  107.      $   8,            64,           16,           1 /
  108. C
  109.       N = 0
  110. C
  111. C --- FILL ITMLST
  112. C
  113.       ITEM(1)   = 8
  114.       ITEM(2)   = %LOC( JPI$_AUTHPRIV )
  115.       ITMLST(2) = %LOC( QUAD(1) )
  116.       ITMLST(3) = %LOC( LENG )
  117.       ISTAT = SYS$GETJPIW ( ,,, ITMLST, IOSB,, )
  118. C
  119. C --- PROCESS FIRST WORD OF QUAD WORD
  120. C
  121.       DO 10 I = 1,32
  122.          IF ((QUAD(1) .AND. MASK1(I)) .NE. 0) THEN
  123.             N = N + 1
  124.             PRIV(N) = ALL1(I)
  125.          ENDIF
  126. 10       CONTINUE
  127. C
  128. C --- PROCESS SECOND WORD OF QUAD WORD
  129. C
  130.       DO 20 I = 1,7
  131.          IF ((QUAD(2) .AND. MASK2(I)) .NE. 0) THEN
  132.             N = N + 1
  133.             PRIV(N) = ALL2(I)
  134.          ENDIF
  135. 20       CONTINUE
  136.       RETURN
  137.       END
  138. C
  139. C---END GETPRV
  140. C
  141.